home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / ExtUtils / CBuilder / Base.pm
Encoding:
Perl POD Document  |  2009-06-26  |  6.7 KB  |  280 lines
  1. package ExtUtils::CBuilder::Base;
  2.  
  3. use strict;
  4. use File::Spec;
  5. use File::Basename;
  6. use Cwd ();
  7. use Config;
  8. use Text::ParseWords;
  9.  
  10. use vars qw($VERSION);
  11. $VERSION = '0.21';
  12.  
  13. sub new {
  14.   my $class = shift;
  15.   my $self = bless {@_}, $class;
  16.  
  17.   $self->{properties}{perl} = $class->find_perl_interpreter
  18.     or warn "Warning: Can't locate your perl binary";
  19.  
  20.   while (my ($k,$v) = each %Config) {
  21.     $self->{config}{$k} = $v unless exists $self->{config}{$k};
  22.   }
  23.   return $self;
  24. }
  25.  
  26. sub find_perl_interpreter {
  27.   my $perl;
  28.   File::Spec->file_name_is_absolute($perl = $^X)
  29.     or -f ($perl = $Config::Config{perlpath})
  30.     or ($perl = $^X);
  31.   return $perl;
  32. }
  33.  
  34. sub add_to_cleanup {
  35.   my $self = shift;
  36.   foreach (@_) {
  37.     $self->{files_to_clean}{$_} = 1;
  38.   }
  39. }
  40.  
  41. sub cleanup {
  42.   my $self = shift;
  43.   foreach my $file (keys %{$self->{files_to_clean}}) {
  44.     unlink $file;
  45.   }
  46. }
  47.  
  48. sub object_file {
  49.   my ($self, $filename) = @_;
  50.  
  51.   # File name, minus the suffix
  52.   (my $file_base = $filename) =~ s/\.[^.]+$//;
  53.   return "$file_base$self->{config}{obj_ext}";
  54. }
  55.  
  56. sub arg_include_dirs {
  57.   my $self = shift;
  58.   return map {"-I$_"} @_;
  59. }
  60.  
  61. sub arg_nolink { '-c' }
  62.  
  63. sub arg_object_file {
  64.   my ($self, $file) = @_;
  65.   return ('-o', $file);
  66. }
  67.  
  68. sub arg_share_object_file {
  69.   my ($self, $file) = @_;
  70.   return ($self->split_like_shell($self->{config}{lddlflags}), '-o', $file);
  71. }
  72.  
  73. sub arg_exec_file {
  74.   my ($self, $file) = @_;
  75.   return ('-o', $file);
  76. }
  77.  
  78. sub arg_defines {
  79.   my ($self, %args) = @_;
  80.   return map "-D$_=$args{$_}", keys %args;
  81. }
  82.  
  83. sub compile {
  84.   my ($self, %args) = @_;
  85.   die "Missing 'source' argument to compile()" unless defined $args{source};
  86.   
  87.   my $cf = $self->{config}; # For convenience
  88.  
  89.   $args{object_file} ||= $self->object_file($args{source});
  90.   
  91.   my @include_dirs = $self->arg_include_dirs
  92.     (@{$args{include_dirs} || []},
  93.      $self->perl_inc());
  94.   
  95.   my @defines = $self->arg_defines( %{$args{defines} || {}} );
  96.   
  97.   my @extra_compiler_flags = $self->split_like_shell($args{extra_compiler_flags});
  98.   my @cccdlflags = $self->split_like_shell($cf->{cccdlflags});
  99.   my @ccflags = $self->split_like_shell($cf->{ccflags});
  100.   my @optimize = $self->split_like_shell($cf->{optimize});
  101.   my @flags = (@include_dirs, @defines, @cccdlflags, @extra_compiler_flags,
  102.            $self->arg_nolink,
  103.            @ccflags, @optimize,
  104.            $self->arg_object_file($args{object_file}),
  105.           );
  106.   
  107.   my @cc = $self->split_like_shell($cf->{cc});
  108.   
  109.   $self->do_system(@cc, @flags, $args{source})
  110.     or die "error building $args{object_file} from '$args{source}'";
  111.  
  112.   return $args{object_file};
  113. }
  114.  
  115. sub have_compiler {
  116.   my ($self) = @_;
  117.   return $self->{have_compiler} if defined $self->{have_compiler};
  118.   
  119.   my $tmpfile = File::Spec->catfile(File::Spec->tmpdir, 'compilet.c');
  120.   {
  121.     local *FH;
  122.     open FH, "> $tmpfile" or die "Can't create $tmpfile: $!";
  123.     print FH "int boot_compilet() { return 1; }\n";
  124.     close FH;
  125.   }
  126.  
  127.   my ($obj_file, @lib_files);
  128.   eval {
  129.     $obj_file = $self->compile(source => $tmpfile);
  130.     @lib_files = $self->link(objects => $obj_file, module_name => 'compilet');
  131.   };
  132.   warn $@ if $@;
  133.   my $result = $self->{have_compiler} = $@ ? 0 : 1;
  134.   
  135.   foreach (grep defined, $tmpfile, $obj_file, @lib_files) {
  136.     1 while unlink;
  137.   }
  138.   return $result;
  139. }
  140.  
  141. sub lib_file {
  142.   my ($self, $dl_file) = @_;
  143.   $dl_file =~ s/\.[^.]+$//;
  144.   $dl_file =~ tr/"//d;
  145.   return "$dl_file.$self->{config}{dlext}";
  146. }
  147.  
  148.  
  149. sub exe_file {
  150.   my ($self, $dl_file) = @_;
  151.   $dl_file =~ s/\.[^.]+$//;
  152.   $dl_file =~ tr/"//d;
  153.   return "$dl_file$self->{config}{_exe}";
  154. }
  155.  
  156. sub need_prelink { 0 }
  157.  
  158. sub extra_link_args_after_prelink { return }
  159.  
  160. sub prelink {
  161.   my ($self, %args) = @_;
  162.   
  163.   ($args{dl_file} = $args{dl_name}) =~ s/.*::// unless $args{dl_file};
  164.   
  165.   require ExtUtils::Mksymlists;
  166.   ExtUtils::Mksymlists::Mksymlists( # dl. abbrev for dynamic library
  167.     DL_VARS  => $args{dl_vars}      || [],
  168.     DL_FUNCS => $args{dl_funcs}     || {},
  169.     FUNCLIST => $args{dl_func_list} || [],
  170.     IMPORTS  => $args{dl_imports}   || {},
  171.     NAME     => $args{dl_name},        # Name of the Perl module
  172.     DLBASE   => $args{dl_base},        # Basename of DLL file
  173.     FILE     => $args{dl_file},        # Dir + Basename of symlist file
  174.     VERSION  => (defined $args{dl_version} ? $args{dl_version} : '0.0'),
  175.   );
  176.   
  177.   # Mksymlists will create one of these files
  178.   return grep -e, map "$args{dl_file}.$_", qw(ext def opt);
  179. }
  180.  
  181. sub link {
  182.   my ($self, %args) = @_;
  183.   return $self->_do_link('lib_file', lddl => 1, %args);
  184. }
  185.  
  186. sub link_executable {
  187.   my ($self, %args) = @_;
  188.   return $self->_do_link('exe_file', lddl => 0, %args);
  189. }
  190.  
  191. sub _do_link {
  192.   my ($self, $type, %args) = @_;
  193.  
  194.   my $cf = $self->{config}; # For convenience
  195.   
  196.   my $objects = delete $args{objects};
  197.   $objects = [$objects] unless ref $objects;
  198.   my $out = $args{$type} || $self->$type($objects->[0]);
  199.   
  200.   my @temp_files;
  201.   @temp_files =
  202.     $self->prelink(%args,
  203.            dl_name => $args{module_name}) if $args{lddl} && $self->need_prelink;
  204.   
  205.   my @linker_flags = ($self->split_like_shell($args{extra_linker_flags}),
  206.               $self->extra_link_args_after_prelink(%args, dl_name => $args{module_name},
  207.                                prelink_res => \@temp_files));
  208.  
  209.   my @output = $args{lddl} ? $self->arg_share_object_file($out) : $self->arg_exec_file($out);
  210.   my @shrp = $self->split_like_shell($cf->{shrpenv});
  211.   my @ld = $self->split_like_shell($cf->{ld});
  212.   
  213.   $self->do_system(@shrp, @ld, @output, @$objects, @linker_flags)
  214.     or die "error building $out from @$objects";
  215.   
  216.   return wantarray ? ($out, @temp_files) : $out;
  217. }
  218.  
  219.  
  220. sub do_system {
  221.   my ($self, @cmd) = @_;
  222.   print "@cmd\n" if !$self->{quiet};
  223.   return !system(@cmd);
  224. }
  225.  
  226. sub split_like_shell {
  227.   my ($self, $string) = @_;
  228.   
  229.   return () unless defined($string);
  230.   return @$string if UNIVERSAL::isa($string, 'ARRAY');
  231.   $string =~ s/^\s+|\s+$//g;
  232.   return () unless length($string);
  233.   
  234.   return Text::ParseWords::shellwords($string);
  235. }
  236.  
  237. # if building perl, perl's main source directory
  238. sub perl_src {
  239.   # N.B. makemaker actually searches regardless of PERL_CORE, but
  240.   # only squawks at not finding it if PERL_CORE is set
  241.  
  242.   return unless $ENV{PERL_CORE};
  243.  
  244.   my $Updir = File::Spec->updir;
  245.   my $dir   = File::Spec->curdir;
  246.  
  247.   # Try up to 5 levels upwards
  248.   for (0..10) {
  249.     if (
  250.     -f File::Spec->catfile($dir,"config_h.SH")
  251.     &&
  252.     -f File::Spec->catfile($dir,"perl.h")
  253.     &&
  254.     -f File::Spec->catfile($dir,"lib","Exporter.pm")
  255.        ) {
  256.       return Cwd::realpath( $dir );
  257.     }
  258.  
  259.     $dir = File::Spec->catdir($dir, $Updir);
  260.   }
  261.  
  262.   warn "PERL_CORE is set but I can't find your perl source!\n";
  263.   return ''; # return empty string if $ENV{PERL_CORE} but can't find dir ???
  264. }
  265.  
  266. # directory of perl's include files
  267. sub perl_inc {
  268.   my $self = shift;
  269.  
  270.   $self->perl_src() || File::Spec->catdir($self->{config}{archlibexp},"CORE");
  271. }
  272.  
  273. sub DESTROY {
  274.   my $self = shift;
  275.   local($., $@, $!, $^E, $?);
  276.   $self->cleanup();
  277. }
  278.  
  279. 1;
  280.